home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / dndlb.exe / DIALTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-16  |  2.8 KB  |  101 lines
  1. { ************************************************************************
  2.   *   Program :      DialTest.Pas
  3.   *
  4.   *   Author  :      Ian Hayes
  5.   *                  Soft Systems Ltd,
  6.   *                  London UK
  7.   *                  Compuserve id: 100010,1415
  8.   *
  9.   *  Description :   An adaption of the Borland demo to show
  10.   *                  drag'n drop lisboxes in action.
  11.   *
  12.   ************************************************************************ }
  13.  
  14. program DialTest;
  15.  
  16. {$R DIALTEST.RES}
  17.  
  18. uses WinTypes, WinProcs, OWindows, ODialogs, DndLb;
  19.  
  20. const
  21.   TheMenu     = 100;
  22.   id_lb1      = 111;
  23.   id_lb2      = 112;
  24.   cm_DialTest = 101;
  25.  
  26. type
  27.   PTestDialog = ^TTestDialog;
  28.   TTestDialog = object(TDialog)
  29.     lb1,lb2: PDndListBox;
  30.     CONSTRUCTOR Init(AParent: PWindowsObject; AName: PChar);
  31.     PROCEDURE SetupWindow; VIRTUAL;
  32.   end;
  33.  
  34.   PTestWindow = ^TTestWindow;
  35.   TTestWindow = object(TWindow)
  36.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  37.     procedure CMDialTest(var Msg: TMessage); virtual cm_First + cm_DialTest;
  38.   end;
  39.  
  40.   TDlgApplication = object(TApplication)
  41.     procedure InitMainWindow; virtual;
  42.   end;
  43.  
  44. { TTestDialog }
  45.  
  46. CONSTRUCTOR TTestDialog.Init(AParent: PWindowsObject; AName: PChar);
  47. BEGIN
  48.    INHERITED Init(AParent,AName);
  49.    { set up drag-n-drop listboxes so that they delete the
  50.      item from the starting listbox }
  51.    lb1 := NEW(PDndListBox,InitResource(@Self,id_lb1,TRUE));
  52.    lb2 := NEW(PDndListBox,InitResource(@Self,id_lb2,TRUE));
  53. END;
  54.  
  55. procedure TTestDialog.SetupWindow;
  56. var
  57.   TextItem : PChar;
  58. begin
  59.   INHERITED SetupWindow;
  60.   TextItem := 'Item 1';
  61.   SendDlgItemMsg(id_LB1, lb_AddString, 0, Longint(TextItem));
  62.   TextItem := 'Item 2';
  63.   SendDlgItemMsg(id_LB1, lb_AddString, 0, Longint(TextItem));
  64.   TextItem := 'Item 3';
  65.   SendDlgItemMsg(id_LB1, lb_AddString, 0, Longint(TextItem));
  66.   TextItem := 'Item 4';
  67.   SendDlgItemMsg(id_LB1, lb_AddString, 0, Longint(TextItem));
  68.   TextItem := 'Item 5';
  69.   SendDlgItemMsg(id_LB1, lb_AddString, 0, Longint(TextItem));
  70.   TextItem := 'Item 6';
  71.   SendDlgItemMsg(id_LB1, lb_AddString, 0, Longint(TextItem));
  72.   TextItem := 'Item 7';
  73.   SendDlgItemMsg(id_LB1, lb_AddString, 0, Longint(TextItem));
  74. end;
  75.  
  76. { TTestWindow }
  77. constructor TTestWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  78. begin
  79.   inherited Init(AParent, ATitle);
  80.   Attr.Menu := LoadMenu(Hinstance, MakeIntResource(TheMenu));
  81. end;
  82.  
  83. procedure TTestWindow.CMDialTest(var Msg: TMessage);
  84. begin
  85.   Application^.ExecDialog(New(PTestDialog, Init(@Self, 'DIAL1')));
  86. end;
  87.  
  88. { TDlgApplication }
  89. procedure TDlgApplication.InitMainWindow;
  90. begin
  91.   MainWindow := New(PTestWindow, Init(nil, 'Dialog Tester'));
  92. end;
  93.  
  94. var
  95.   MyApp: TDlgApplication;
  96. begin
  97.   MyApp.Init('DialTest');
  98.   MyApp.Run;
  99.   MyApp.Done;
  100. end.
  101.